home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22o.zip / DISPLAY2.4TH < prev    next >
Text File  |  1994-08-13  |  4KB  |  118 lines
  1. \ FORTH COMPILER  DISPLAY LIBRARY                 05/13/93
  2.  
  3. 0 #IF
  4. COPYRIGHT 1993 (C) BY THOMAS ALMY.  ALL RIGHTS RESERVED
  5. Permission is granted to registered users of ForthCMP to sell or distribute
  6. computer programs incorporating the compiled contents of this file.
  7.  
  8. Fast Terminal output for IBM pc or compatibles.
  9. Works with monochrome or color monitors, any text display mode.
  10. EMIT generates all 256 characters -- no control functions.
  11.  
  12. Include file DISPLAY1 at start of program.
  13. Include this file before FORTHLIB
  14. Define constant VID-DELAY non-zero for vertical retrace blanking
  15. Execute SETUP-VID at program start, and UNSETUP-VID at finish
  16.  
  17. This library defines EMIT, TYPE, CS:TYPE, CLS, GOTOXY, FOREGROUND,
  18. BACKGROUND, INTENSITY, -INTENSITY, BLINK, -BLINK, as in
  19. PC/Forth. DO NOT use CONSOLE PRINTER and/or MESSAGES!
  20.  
  21.  
  22. #THEN
  23.  
  24. 10 HEX
  25. 1 0 IN/OUT
  26. : setcursor ( DISPL -- )   DUP cursor !  crtstart +
  27.    2/ DUP 0F crtport @ PC! crtport @ 1+ PC!
  28.    >< 0E crtport @ PC! crtport @ 1+ PC! ;
  29. 2 0 IN/OUT
  30. : GOTOXY ( X Y -- ) c/l * + 2* setcursor ;
  31. FIND VID-DELAY #IF DROP #ELSE 0 CONSTANT VID-DELAY #THEN
  32. 0 0 IN/OUT
  33. : SETUP-VID
  34.  40 49 C@L 7 = IF 3B4 crtport ! B000 vidseg ! \ MONOCHROME
  35.      ELSE \ COLOR
  36.      40 84 C@L ?DUP IF 1+ EQU l/s THEN THEN \ EGA/VGA 
  37.      40 4A @L EQU c/l     \ characters per line
  38.      c/l l/s * EQU c/s   c/l l/s 1- * 2* EQU c/sm1
  39.  40 4E @L EQU crtstart
  40.  40 50 C@L 40 51 C@L GOTOXY
  41.  vidseg @  c/sm1 1+ crtstart + C@L style ! ;
  42. 0 0 IN/OUT
  43. CODE UNSETUP-VID  cursor [] AX MOV  ' c/l [] BX MOV DX DX XOR
  44.   AX 1 SAR  BX IDIV
  45.   AL DH MOV  2 # AH MOV BH BH XOR  10 INT  RET END-CODE
  46. CODE scrmove  ( source dest wordCount -- )
  47.     BX POP CX POP DI POP SI POP
  48.     ' crtstart [] SI ADD
  49.     ' crtstart [] DI ADD
  50.     LOOP IF,  DS PUSHSEG
  51. VID-DELAY #IF  B800 # vidseg [] CMP  =0 IF,  3DA # DX MOV
  52.    BEGIN,  BYTE [DX] IN  8 # AL TEST  =0 ~ UNTIL,
  53.       DX DEC  DX DEC  21 # AL MOV  BYTE [DX] OUT  THEN, #THEN
  54.               vidseg [] AX MOV   AX DS >SEG  AX ES >SEG
  55.               REPZ MOVS  DS POPSEG
  56. VID-DELAY #IF  B800 # vidseg [] CMP  =0 IF,  3D8 # DX MOV
  57.       29 # AL MOV  BYTE [DX] OUT  THEN, #THEN
  58.       THEN, BX JMPI END-CODE
  59. 2 0 IN/OUT
  60. CODE scrfill ( source wordCount -- )
  61.     vidseg [] ES >SEG
  62.     BX PUSH  ' crtstart [] BX ADD
  63.     20 # BYTE ES: [BX] MOV
  64.     style [] CL MOV  CL ES: 1 +[BX] MOV
  65.     BX POP
  66.     BX PUSH  BX INC BX INC BX PUSH  AX DEC AX PUSH
  67.     CALL' scrmove   RET  END-CODE
  68. 0 0 IN/OUT
  69. : scrollup  c/l 2*  0  c/sm1 2/ scrmove
  70.       c/sm1 c/l  scrfill
  71.       c/sm1 cursor ! ;
  72. U: CLS  0  c/s  scrfill  0 setcursor ;
  73. U: FOREGROUND 0F AND style @ F0 AND OR style ! ;
  74. U: BACKGROUND 7 AND 4 << style @ 0F AND OR style ! ;
  75. U: BLINK 80 style CSET ;
  76. U: -BLINK 80 style CRESET ;
  77. U: INTENSITY  8 style CSET ;
  78. U: -INTENSITY 8 style CRESET ;
  79.  
  80. : EMIT  cursor @  c/s 2* >= IF scrollup THEN
  81.         vidseg @ cursor @ crtstart + C!L
  82.         style @ vidseg @ cursor @ 1+ crtstart + C!L
  83.         cursor @ 2+ setcursor ;
  84. : CR   cursor @  c/l 2*  U/  1+  c/l 2*  *
  85.     DUP c/s 2* = IF DROP scrollup  cursor @ THEN
  86.     setcursor ;
  87.  
  88. VID-DELAY 0= #IF
  89. 2 1 IN/OUT
  90. CODE (type) ( AX has count, BX has string )
  91.     cursor [] DI MOV  AX CX MOV  style [] AH MOV  BX SI MOV
  92.     ' crtstart [] DI ADD
  93.     vidseg [] ES >SEG  LOOP IF, BEGIN,  BYTE LODS
  94.     STOS  LOOP ~ UNTIL,  THEN,
  95.     DI AX MOV   ' crtstart [] AX SUB
  96.     RET  END-CODE
  97. SEPDSEG? NOT #IF CODE CS:TYPE END-CODE #THEN
  98. : TYPE c/s cursor @ - OVER 2* < IF ( too big )
  99.        0 ?DO COUNT EMIT LOOP DROP
  100.        ELSE (type) setcursor THEN ;
  101. #THEN
  102.  
  103. VID-DELAY 0= #IF
  104. SEPDSEG? #IF
  105. 2 1 IN/OUT
  106. CODE (cs:type) ( AX has count, BX has string )
  107.     cursor [] DI MOV  AX CX MOV  style [] AH MOV  BX SI MOV
  108.     ' crtstart [] DI ADD
  109.     vidseg [] ES >SEG  LOOP IF, BEGIN, CS: BYTE LODS  STOS
  110.        LOOP ~ UNTIL,  THEN,
  111.     DI AX MOV   ' crtstart [] AX SUB
  112.     RET  END-CODE
  113. : CS:TYPE c/s 2* cursor @ - OVER 2* < IF ( too big )
  114.        0 ?DO CS: COUNT EMIT LOOP DROP
  115.        ELSE (cs:type) setcursor THEN ;
  116. #THEN   #THEN
  117. 0A = #IF DECIMAL #THEN
  118.